Temporal by state and indicator

Took Prescription Medication for Mental Health, Last 4 Weeks

Resources for Value-Suppressing Uncertainty Palettes: https://github.com/clauswilke/multiscales

MainStates <- map_data("state") %>% mutate(State = tolower(region)) 
merged_pres <- inner_join(MainStates, data_states_13_meds, by = "State")

region.lab.data <- merged_pres %>%
  group_by(State) %>% summarise(long=mean(long), lat=mean(lat))

# Color for Value-Suppressing Uncertainty Palettes
colors <- scales::colour_ramp(
  colors = c(red = "#AC202F", purple = "#740280", blue = "#2265A3")
)((0:7)/7)

#---- VSUP ggplot

# map_took_pres <- ggplot(merged_pres) +
#   geom_polygon(aes(x=long, y=lat, group=group, fill = zip(Value, CIint), frame =  t), 
#                color="white", size = 0.2) +
#   bivariate_scale("fill",
#                   pal_vsup(values = colors, max_desat = 0.8, pow_desat = 0.2, max_light = 0.7, pow_light = 1),
#                   name = c("Percentage", "uncertainty"),
#                   # limits = list(c(min(merged_pres$Value), max(merged_pres$Value)),
#                                 # c(min(merged_pres$CIint), max(merged_pres$CIint))),
#                   breaks = list(waiver(), c(0, 1)),
#                   # breaks = list(c(10, 15, 20, 25, 30, 35), c(0, 5, 10, 15, 20)),
#                   labels = list(waiver(), scales::percent),
#                   guide = "colourfan") + theme_void()

map_took_pres <- ggplot() + 
  geom_polygon(data=merged_pres, 
          aes(x=long, y=lat, group=group, fill = Value, frame =  t), 
          color="white", size = 0.2) +
  scale_fill_gradient(
    low = "lightblue", high = "darkred",
    name = c("Percentage")) + 
  geom_text(aes(label = State,x = long, y = lat), data = region.lab.data, size=1, alpha = 0.001) +
  theme_classic()+
  theme(axis.line=element_blank(),
      axis.text.x=element_blank(),
      axis.text.y=element_blank(),
      axis.ticks=element_blank(),
      axis.title.x=element_blank(),
      axis.title.y=element_blank())+
  labs(title="Took Prescription Medication for Mental Health, Last 4 Weeks", fill = "%") 

fig <- ggplotly(map_took_pres) 
fig <- fig %>% 
  animation_opts(
    50, easing = "elastic", redraw = FALSE
  ) %>%
  animation_slider(
    currentvalue = list(prefix = "Time Period ", font = list(color="red"))
  ) #%>%
  # layout(annotations = list(x = -120, y = 25, text = paste("Time Period: ",
  #   merged_pres$`Time Period Label`), showarrow = F))
  

fig$x$frames <- lapply(
  fig$x$frames, function(f) { 
    f$data <- lapply(f$data, function(d) d[!names(d) %in% c("x", "y")])
    f 
  })

fig

Received Counseling or Therapy, Last 4 Weeks

Took Prescription Medication for Mental Health And/Or Received Counseling or Therapy, Last 4 Weeks

Needed Counseling or Therapy But Did Not Get It, Last 4 Weeks

Period mismatch

## # A tibble: 16 x 2
##    `Time Period Label` `Time Period`
##    <chr>                       <dbl>
##  1 Aug 19 - Aug 31                13
##  2 Sep 2 - Sep 14                 14
##  3 Sep 16 - Sep 28                15
##  4 Sep 30 - Oct 12                16
##  5 Oct 14 - Oct 26                17
##  6 Oct 28 - Nov 9                 18
##  7 Nov 11 - Nov 23                19
##  8 Nov 25 - Dec 7                 20
##  9 Dec 9 - Dec 21                 21
## 10 Dec 22 - Jan 5                 22
## 11 Jan 6 - Jan 18                 23
## 12 Jan 20 - Feb 1                 24
## 13 Feb 3 - Feb 15                 25
## 14 Feb 17 - Mar 1                 26
## 15 Mar 3 - Mar 15                 27
## 16 Mar 17 - Mar 29                28

Mar 17 - Mar 29 –> 27 Dec 22 - Jan 5 –> 1 –> between 21 and 22

period numbers mismatch

add national averages

add state label